Load libraries
library(tidyverse)
library(plotly)
Make function to simulate paths
SimPath <- function(startvalue=100, meangrowth=0.1, sd=0.01, iterations=10) {
i <- 0
sim <- c(i)
values <- c(startvalue)
while(i < iterations) {
i <- i+1
sim <- c(sim, i)
g <- rnorm(1, meangrowth, sd)
values <- c(values, values[i]*(1+g))
}
return(data.frame(sim, values))
}
SimPath(100, 0.10, 0.01, 3)
Create graphs
# Input data
mean <- 0.30
sd <- 0.20
t <- 8
expval <- 100*(1+mean)^t
expDF <- data.frame(x=t, y=expval)
# Start calculations
n <- 1
pathsDF <- cbind(run = rep(n,t+1), SimPath(100, mean, sd, t))
while(n < 400) {
n <- n + 1
run <- rep(n,t+1)
pathsDF <- rbind(pathsDF, cbind(run, SimPath(100, mean, sd, t)))
}
pathsDF$run <- as.factor(pathsDF$run)
p <- ggplot() +
geom_line(data = pathsDF, aes(x=sim, y=values, group=run), colour="Red", alpha=1/10) +
geom_point(data = expDF, aes(x=x, y=y, text=sprintf("Expected end value")), colour = "RoyalBlue", size=3) +
theme(legend.position="none")
Ignoring unknown aesthetics: text
ggplotly(p)
LS0tCnRpdGxlOiAiU2ltdWxhdGUgcmFuZG9tIHBhdGhzIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKLS0tCgpMb2FkIGxpYnJhcmllcwoKYGBge3J9CmxpYnJhcnkodGlkeXZlcnNlKQpsaWJyYXJ5KHBsb3RseSkKYGBgCgoKCk1ha2UgZnVuY3Rpb24gdG8gc2ltdWxhdGUgcGF0aHMgCgpgYGB7cn0KU2ltUGF0aCA8LSBmdW5jdGlvbihzdGFydHZhbHVlPTEwMCwgbWVhbmdyb3d0aD0wLjEsIHNkPTAuMDEsIGl0ZXJhdGlvbnM9MTApIHsKICAKICBpIDwtIDAKICBzaW0gPC0gYyhpKQogIHZhbHVlcyA8LSBjKHN0YXJ0dmFsdWUpCiAgCiAgd2hpbGUoaSA8IGl0ZXJhdGlvbnMpIHsKICAgIGkgPC0gaSsxCiAgICBzaW0gPC0gYyhzaW0sIGkpCiAgICBnIDwtIHJub3JtKDEsIG1lYW5ncm93dGgsIHNkKQogICAgdmFsdWVzIDwtIGModmFsdWVzLCB2YWx1ZXNbaV0qKDErZykpCiAgfQogIHJldHVybihkYXRhLmZyYW1lKHNpbSwgdmFsdWVzKSkKfQoKU2ltUGF0aCgxMDAsIDAuMTAsIDAuMDEsIDMpCmBgYAoKQ3JlYXRlIGdyYXBocwoKYGBge3J9CiMgSW5wdXQgZGF0YQptZWFuIDwtIDAuMzAKc2QgPC0gMC4yMAp0IDwtIDgKZXhwdmFsIDwtIDEwMCooMSttZWFuKV50CmV4cERGIDwtIGRhdGEuZnJhbWUoeD10LCB5PWV4cHZhbCkKCiMgU3RhcnQgY2FsY3VsYXRpb25zCm4gPC0gMQpwYXRoc0RGIDwtIGNiaW5kKHJ1biA9IHJlcChuLHQrMSksIFNpbVBhdGgoMTAwLCBtZWFuLCBzZCwgdCkpCndoaWxlKG4gPCA0MDApIHsKICBuIDwtIG4gKyAxCiAgcnVuIDwtIHJlcChuLHQrMSkKICBwYXRoc0RGIDwtIHJiaW5kKHBhdGhzREYsIGNiaW5kKHJ1biwgU2ltUGF0aCgxMDAsIG1lYW4sIHNkLCB0KSkpCiAgCn0KcGF0aHNERiRydW4gPC0gYXMuZmFjdG9yKHBhdGhzREYkcnVuKQpwIDwtIGdncGxvdCgpICsKICBnZW9tX2xpbmUoZGF0YSA9IHBhdGhzREYsIGFlcyh4PXNpbSwgeT12YWx1ZXMsIGdyb3VwPXJ1biksIGNvbG91cj0iUmVkIiwgYWxwaGE9MS8xMCkgKwogIGdlb21fcG9pbnQoZGF0YSA9IGV4cERGLCBhZXMoeD14LCB5PXksIHRleHQ9c3ByaW50ZigiRXhwZWN0ZWQgZW5kIHZhbHVlIikpLCBjb2xvdXIgPSAiUm95YWxCbHVlIiwgc2l6ZT0zKSArCiAgdGhlbWUobGVnZW5kLnBvc2l0aW9uPSJub25lIikKCmdncGxvdGx5KHApCmBgYAoKCg==